Fritz: All Fritz/All Fritz.zip/All Fritz/FILES/EDUCLING/SPELLBEE.LZH/ALGEBRA.BAS

BASIC Source File | 1983-02-17 | 6KB | 142 lines

1 '****  ALGEBRA AND GEOMETRY PROGRAM
2 '** for the IBM PC...requires 32K and Color/Graphics
3 ON ERROR GOTO 800
5 CLEAR : KEY OFF : FALSE = 0 : TRUE = NOT FALSE
6 SCREEN 0 : WIDTH 80
7 '****  MONOCHROME SENSING ROUTINE
8 DEF SEG=&H40 : DISPLAY=PEEK(&H10)
9 IF (DISPLAY AND &H30) = &H30 THEN MONOCHROME = TRUE ELSE MONOCHROME = FALSE
10 SCREEN 0 : WIDTH 80
12 CLS : PRINT "ALGEBRA Graphics Program"
14 PRINT "    Steve VanArsdale"
16 PRINT "Mt.Prospect, Illinois  312-259-7224"
18 PRINT
20 PRINT "SELECT algebra function:"
30 PRINT "A ... for the SINE of X"
40 PRINT "B ... for the COSINE of X"
50 PRINT "C ... for the TANGENT of X"
51 PRINT "D ... for the SECANT of X"
52 PRINT "E ... for the COTANGENT of X"
53 PRINT "F ... for the COSECANT of X"
54 PRINT "G ... for the INVERSE HYPERBOLIC SINE of X"
55 PRINT "H ... for the SQUARE ROOT of X"
60 PRINT " > ";:CHOICE$=INPUT$(1)
70 IF CHOICE$ ="A" OR CHOICE$ = "a" THEN DEF FNFUNCTION(X)=SIN(X):FUNCTION$="SIN(X)":GOTO 110
80 IF CHOICE$ ="B" OR CHOICE$ = "b"  THEN DEF FNFUNCTION(X)=COS(X):FUNCTION$="COSINE(X)":GOTO 110
90 IF CHOICE$ ="C" OR CHOICE$ = "c" THEN DEF FNFUNCTION(X)=TAN(X):FUNCTION$="TANGENT(X)":GOTO 110
91 IF CHOICE$ ="D" OR CHOICE$ = "d" THEN DEF FNFUNCTION(X)=1/COS(X):FUNCTION$="SECANT(X)":GOTO 110
92 IF CHOICE$ ="E" OR CHOICE$ = "e" THEN DEF FNFUNCTION(X)=1/TAN(X):FUNCTION$="COTANGENT(X)":GOTO 110
93 IF CHOICE$ ="F" OR CHOICE$ = "f" THEN DEF FNFUNCTION(X)=1/SIN(X):FUNCTION$="COSECANT(X)":GOTO 110
94 IF CHOICE$ ="G" OR CHOICE$ = "g" THEN DEF FNFUNCTION(X)=LOG(X+SQR(X*X+1)):FUNCTION$="INVERSE HYPERBOLIC SINE(X)":GOTO 110
95 IF CHOICE$ ="H" OR CHOICE$ = "h" THEN DEF FNFUNCTION(X)=SQR(ABS(X)):FUNCTION$="SQ.RT(X)":GOTO 110
100 GOTO 10
110 PRINT "DEPTH OF ";FUNCTION$;" GRAPH (0 TO 50): ";:INPUT "",DEPTH
115 IF DEPTH < 0 OR DEPTH > 50 THEN GOTO 110
120 CLS:SCREEN 0 :WIDTH 80
155 '**** ACTIVATION OF COLOR/GRAPHICS MONITOR IF AVAILABLE ****
160 IF MONOCHROME = TRUE THEN WIDTH 80: DEF SEG=0: A=PEEK(&H410): POKE &H410,(A AND &HCF) OR &H20 : SCREEN 0 : WIDTH 80
170 SCREEN 0 :WIDTH 80
190 KEY(10) ON : ON KEY(10) GOSUB 800 : KEY(10) STOP
200 '****   GRAPHICS ROUTINE FOR ALGEBRAIC FUNCTIONS ****
205 CLS
210 SCREEN 1,0:COLOR 0,1
220 C=100:R=100
230 '** AXIS DRAWING ROUTINE
240 GOSUB 900
245 '** PLOTTING PARAMETERS DISPLAY
250 LOCATE 17,1:PRINT "GRAPH of:"
260 LOCATE 18,1:PRINT FUNCTION$
270 LOCATE 20,1:PRINT "  X     Y"
275 '** PLOTTING ROUTINE
277 X=0:Y=0:XX=-1:YY=FNFUNCTION(XX):PSET(100,100)
280 FOR X = -1 TO 7 STEP .1
290 LOCATE 21,1:PRINT USING "##.##";X
295 KEY(10) ON : KEY(10) STOP
300 Y = FNFUNCTION(X)
302 YLIMIT=98-30*Y : DEPTHLIMIT=100-30*Y-DEPTH : IF YLIMIT < 0 OR YLIMIT > 200 OR DEPTHLIMIT < 0 THEN GOTO 390
305 ON ERROR GOTO 1000
310 LOCATE 21,7:PRINT USING "##.##";Y
320 PSET(20*X+100,100-30*Y),2
330 IF DEPTH <> 0 THEN LINE (20*X+101,99-30*Y)-(20*X+100+DEPTH,100-30*Y-DEPTH),1
350 LINE (20*XX+100,100-30*YY)-(20*X+100,100-30*Y),2
360 IF DEPTH <> 0 THEN LINE (20*XX+100+DEPTH,100-30*YY-DEPTH)-(20*X+100+DEPTH,100-30*Y-DEPTH),2
390 XX=X:YY=Y
400 NEXT X
405 GOSUB 900
410 LOCATE 25,1: PRINT "ENTER  X  TO EXIT";:VALUE$=INPUT$(1)
415 IF VALUE$ <> "X" AND VALUE$ <> "x" THEN GOTO 10 ELSE CLS : KEY(10) ON
420 '****  SPECIAL EXIT DISPLAY ****
425 '** AXIS DRAWING SUBROUTINE
427 GOSUB 900
430 '** PLANE GRID DRAWING ROUTINE
431 FOR X = 10 TO R-10 STEP 10
432 LINE (C+X,R-X)-(105+C+X,R-X),1
433 LINE (C+X,R-X)-(C+X,0),1
434 LINE (C,R-X)-(195-X,5),1
435 LINE (C+X,R)-(195+X,5),1
436 NEXT X
438 LOCATE 1,22:PRINT " Z axis"
440 '** HOOP ROUTINE
450 CIRCLE (160,90),50,2,,,1
460 FOR I = 1 TO 20
470 CIRCLE STEP (1,-1),50,2,,,1
480 NEXT I
490 CIRCLE (160,90),50,0,,,1
500 '** ELLIPTICAL TUBE ROUTINE
505 CIRCLE (155,90),25,1,,,.5
510 FOR I = 1 TO 35
520 CIRCLE STEP (1,1),25,1,,,.5
530 NEXT I
540 CIRCLE STEP (1,1),25,0,,,.5
550 CIRCLE (155,90),25,0,0,3.14,.5
560 FOR I = 1 TO 20
570 CIRCLE STEP (1,-1),24,1,,,.5
580 NEXT I
590 CIRCLE (155,90),25,2,0,3.14,.5
600 '***  CONE ROUTINE
605 CIRCLE (45,55),38,3,,,1
610 FOR I = 1 TO 38
620 CIRCLE STEP (+1,-1),38-I,(I MOD 2)+2,,,1
630 NEXT I
640 CIRCLE (45,55),38,0,,,1
650 '**  GLOBE ROUTINE
655 CIRCLE (245,170),1,2,,,3
660 FOR I = 1 TO 10 STEP 1
670 CIRCLE STEP (+I/4,-I/4),I*4,1,,,1
680 NEXT I
690 FOR I = 10 TO 0 STEP -1
700 CIRCLE STEP (+I/4,-I/4),I*4,2,,,1
710 NEXT I
715 LINE -(245,170),3
720 '** PYRAMID ROUTINE
740 DRAW "BM10,150;C1;E30;F30;L60"
745 DRAW "BM+30,-28;D13"
750 LINE (40,135)-(11,149),1
760 LINE (40,135)-(69,149),1
770 '** CUBE ROUTINE
775 DRAW "BM265,85;C3;U30;R30;D30;L30"
780 DRAW "BM+20,-20;C3;U30;R30;D30;L30"
790 DRAW "C3;G20;BM+30,0;E20;BM+0,-30;G20;BM-30,0;E20"
799 LOCATE 25,1: PRINT "BYE.";
800 '**** TERMINATION LOGIC
805 IF MONOCHROME = TRUE THEN WIDTH 40: DEF SEG=0: A=PEEK(&H410): POKE &H410,A OR &H30 : SCREEN 0 : WIDTH 80 ELSE FOR I = 1 TO 2000 : NEXT I
840 CLS: PRINT "ALGEBRA Program Terminated."
845 END
900 '****  AXIS DRAWING SUBROUTINE ****
920 '****  AXIS DRAWING SUBROUTINE ****
921 LINE (C,0)-(C,199)
922 LINE (90,110)-(200,0)
924 LINE (0,R)-(319,R)
925 LOCATE 13,1:PRINT "X axis"
926 LOCATE 2,10:PRINT "Y axis"
927 LOCATE 1,22:PRINT " Z axis"
930 RETURN
1000 '****  CALCULATION ERROR HANDLER
1010 RESUME 390
1210 CLS : PRINT "ALGEBRA Graphics Program"
65399 '** DONE - PRESS ENTER TO RETURN TO MENU **
RROR HANDLER
1010 RESUME 390
1210 CLS : PRINT "ALGEBRA Graphics Program"
65399 '*